home *** CD-ROM | disk | FTP | other *** search
/ ASP Advantage 1993 / The Association of Shareware Professionals Advantage CD-ROM 1993.iso / files / commions / ca29_1 / ca29_3.exe / BBMAINT3.CMD < prev    next >
OS/2 REXX Batch file  |  1992-03-24  |  24KB  |  914 lines
  1. ;****    TRACE ON        ; Debugging
  2. ;
  3. ; ----- COM-AND BBS file maintenance script (BULLETIN file)
  4. ;    Commenced: 11/90 R.McG
  5. ; -----------------------------------------------------------------------
  6. ;    Purpose:
  7. ;       The script, named BBMAINT3.CMD, produces the main window for
  8. ;    Bulletin functions of BBMAINT, and implements its functions.  It
  9. ;    is not directly callable itself.
  10. ; -----------------------------------------------------------------------
  11. ;    Usage:
  12. ;       N99 -> Text attribute value (Setup by BBMAINT.CMD)
  13. ;       N98 -> BBMAINT Mainline cursor position
  14. ;       N97 -> BBMAINT Mainline cursor position
  15. ;       N96 -> our mainline cursor position
  16. ;       N95 -> our mainline cursor position
  17. ; -----------------------------------------------------------------------
  18. ;
  19. ;    This script is intended ONLY to be used for FCALL
  20. ;
  21.     IF NOT FCALLED
  22.        WOPEN 10,10,13,70 (cont) NOBUEsc
  23.        ATSAY 10,12 (cont) " BBS Bulletin "
  24.        ATSAY 11,12 (cont) " The script: "*"_SCRIPT"
  25.        ATSAY 12,12 (cont) " is not used by itself... it is called through BBMAINT"
  26.        ATSAY 13,26 (cont) " Press any key to continue "
  27.        ;
  28.        ;    Wait a keypress
  29.        ;
  30.        KEYGET S0        ; Wait for any key
  31.        WCLOSE        ; Close open window
  32.        EXIT         ; Terminate right here
  33.        ENDIF
  34.     GOSUB Bullfile        ; Invoke function
  35.     FRETURN         ; Return to caller
  36. ; -----------------------------------------------------------------------
  37. ; ----- NoBull:  Inform that there's no BBS-Bull file to modify
  38. ;
  39. NoBull:
  40.     WOPEN 10,10,13,70 (cont) NOBUEsc
  41.     ATSAY 10,12 (cont) " BBS BullDir "
  42.     ATSAY 11,12 (cont) " The file: "*S25&"\BBS-Bull"
  43.     ATSAY 12,12 (cont) " does not exist.  Please create subdirectories first."
  44.     ATSAY 13,26 (cont) " Press any key to continue "
  45.     ;
  46.     ;    Wait a keypress
  47.     ;
  48.     KEYGET S0        ; Wait for any key
  49.     WCLOSE
  50. NOBUEsc:
  51.     RETURN
  52. ; -----------------------------------------------------------------------
  53. ; ----- Subroutine: BullFile -> Update Bulletin directory
  54. ;
  55. BullFile:
  56.     GOSUB NewBull        ; Create if not there
  57.     IF NOT ISFILE S25&"\BBS-Bull"
  58.        GOSUB NoBull     ; Inform there's no file
  59.        RETURN        ; .. so we can't continue
  60.        ENDIF
  61. ;
  62. ;    Open a window
  63. ;
  64.     WOPEN 0,0 23,79 (defa) Bull_Esc
  65.     ATSAY 0,2 (defa)   " BBS Bulletins "
  66.     ATSAY 23,25 (defa) " Press ESC to cancel BBMAINT "
  67. ;
  68. ;    Paint the window
  69. ;
  70. BUFI100:
  71.     CLEAR            ; Clear window
  72.     LOCATE 2,2
  73.  
  74.     MESS " 1) Add a bulletin to the list"
  75.     MESS " 2) Delete a bulletin from the list"
  76.     MESS " 3) Modify a bulletin's listing"
  77.     MESS " 4) Print the bulletin list"
  78.     MESS " 5) View the bulletin list"
  79.     MESS "──────────────────────────────────── "
  80.     MESS "Note: Alt-Q to edit a file"
  81.     MESS "      Alt-F for a directory search"
  82.     MESS "      Alt-F10 to shell to DOS"
  83.     MESS " "
  84.     MESS "──────────────────────────────────── "
  85.     MESS " "
  86.     MESS "Select item (carriage return = previous): "
  87.     CURSOR N96,N95        ; Read current cursor
  88. ;
  89. ;    Wait for entry, and interpret
  90. ;
  91. BUFI200:
  92.     LOCATE N96 N95        ; Reposition cursor
  93.     KEYGET S0        ; Wait for it
  94.     SWITCH S0        ; Act according to keyget
  95.       CASE "1"
  96.            GOSUB AddBull
  97.            ENDCASE
  98.       CASE "2"
  99.            GOSUB DelBull
  100.            ENDCASE
  101.       CASE "3"
  102.            GOSUB ModBull
  103.            ENDCASE
  104.       CASE "4"
  105.            GOSUB PrnBull
  106.            ENDCASE
  107.       CASE "5"
  108.            GOSUB ViewBull
  109.            GOTO BUFI100    ; Repaint screen after this
  110.            ENDCASE
  111.       CASE "0d"             ; c/r alone is exit
  112.            WCLOSE        ; Close window...
  113.            RETURN        ; and return to caller
  114.            ENDCASE
  115.       CASE "_NULL"          ; ESC -> Null
  116.            WCLOSE        ; Close window...
  117.            RETURN        ; Leave Main routine
  118.            ENDCASE
  119.       CASE "2100"           ; Alt-F
  120.            MANUAL "0x2100"  ; Perform Dir cmd
  121.            ENDCASE
  122.       CASE "1000"           ; Alt-Q
  123.            MANUAL "0x1000"  ; Edit a file
  124.            ENDCASE
  125.       CASE "7100"           ; Alt-F10
  126.            SHELL
  127.            DWINDOW 1,2,22,78; Reset dwindow after shell
  128.            LEGEND "_LEGEND" ; Redo the legend
  129.            ENDCASE
  130.       DEFAULT        ; None of the above
  131.            SOUND 100,100    ; Bronx cheer
  132.            ENDCASE
  133.       ENDSWITCH
  134.     GOTO BUFI200        ; Repaint screen and ask again
  135. ;
  136. ;    End of bulletin procedure
  137. ;
  138. Bull_Esc:
  139.     S0 = ""                 ; Fake a null entry
  140.     RETURN            ; Leave bulletin routine
  141. ; -----------------------------------------------------------------------
  142. ; ----- AddBUll:  Add a file to the bulletin directory
  143. ;
  144. AddBull:
  145.     SET FLAG(0) OFF     ; Flag for ESCAPE
  146.     WOPEN 10,10,17,75 (cont) ADBUEsc
  147.     ATSAY 10,12 (cont) " BBS Bulletin Add "
  148.     ATSAY 11,12 (cont) "Enter the bulletin number: "
  149.     ATSAY 17,26 (cont) " Press ESC to cancel "
  150.     ;
  151.     ;    Wait a keypress
  152.     ;
  153.     LOCATE 11,42
  154.     GET S0 5        ; get number
  155.     IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit
  156.     LJ S0            ; Left justify
  157.     UPPER S0        ; Upper casefy
  158.     IF NULL S0 GOTO ADBUEnd ; get out on empty entry
  159.     GOSUB LkpBull        ; Lookup name in file
  160.     IF FOUND        ; If its there we can't add it
  161.        WCLOSE        ; Close open window
  162.        GOTO ModBU_Add    ; Skip if found
  163.        ENDIF
  164.     S10 = S0        ; Save File name
  165.     GOTO ADBU100        ; And branch around parallel code
  166. ;
  167. ;    Entry from ModBull... Nothing to modify
  168. ;
  169. AddBU_Mod:
  170.     WOPEN 10,10,17,75 (cont) ADBUEsc
  171.     ATSAY 10,12 (cont) " BBS Bulletin Add "
  172.     ATSAY 11,12 (cont) "Enter the bulletin number: "
  173.     ATSAY 11,42 (cont) S0
  174.     ATSAY 17,26 (cont) " Press ESC to cancel "
  175.     S10 = S0        ; Copy it for remainder
  176. ;
  177. ;    Place file date and time in record
  178. ;
  179. ADBU100:
  180.     DATE S1         ; Want mm/dd/yy form
  181.     S10(5:12) = S1        ; Save date added
  182.     ATSAY 12,12 (cont) "Enter the file name:"
  183.     LOCATE 12,42
  184.     GET S0 12        ; get file name
  185.     IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit
  186.     LJ S0            ; Left justify
  187.     IF NULL S0
  188.        SOUND 100,100    ; Indicate displeasure
  189.        GOTO ADBU100     ; Try again
  190.        ENDIF
  191.     FFIRST S25&"\"*S0       ; Test for file's existence
  192.     S10(14:25) = S0     ; Save File name
  193.     IF SUCCESS GOTO ADBU200 ; Skip if exists
  194. ;
  195. ;    File does not exist...
  196. ;
  197. ADBU110:
  198.     ATSAY 13,12 (cont) "File d.n.e. Add anyway (y/n): "
  199.     LOCATE 13,42
  200.     GET S0 1        ; get resp
  201.     IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit
  202.     IF NULL S0 or NOT FIND "YN" S0(0)
  203.        SOUND 100,100    ; Indicate displeasure
  204.        GOTO ADBU110     ; Try again
  205.        ENDIF
  206.     IF FIND "N" S0(0)
  207.        WCLOSE        ; Close window
  208.        GOTO AddBull     ; And try again
  209.        ENDIF
  210. ;
  211. ;    Ask for a comment field
  212. ;
  213. ADBU200:
  214.     ATSAY 14,12 (cont) "Description: "
  215.     LOCATE 14,26
  216.     GET S0 40        ; get resp
  217.     LJ S0            ; Left justify
  218.     IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit
  219.     IF NULL S0
  220.        SOUND 100,100    ; Indicate displeasure
  221.        GOTO ADBU200     ; Try again
  222.        ENDIF
  223.     S10(26:79) = S0     ; Save comment text
  224. ;
  225. ;    Ask for privileged flag
  226. ;
  227. ADBU250:
  228.     ATSAY 15,12 (cont) "Priveleged access (y/n):  "
  229.     LOCATE 15,42
  230.     GET S0 1        ; get resp
  231.     IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit
  232.     IF NULL S0 or NOT FIND "YN" S0(0)
  233.        SOUND 100,100    ; Indicate displeasure
  234.        GOTO ADBU250     ; Try again
  235.        ENDIF
  236.     IF FIND "Y" S0(0) S10(13:13) = "P" ; Save priveleged access
  237. ;
  238. ;    Ask for one more look
  239. ;
  240. ADBU300:
  241.     ATSAY 16,12 (cont) "OK to add this record?:   "
  242.     LOCATE 16,42
  243.     GET S0 1        ; get resp
  244.     IF FLAG(0) GOTO ADBUEnd ; Exit if ESC hit
  245.     IF NULL S0 or NOT FIND "YN" S0(0)
  246.        SOUND 100,100    ; Indicate displeasure
  247.        GOTO ADBU300     ; Try again
  248.        ENDIF
  249.     IF FIND "N" S0(0)
  250.        WCLOSE        ; Close window
  251.        GOTO AddBull     ; And try again
  252.        ENDIF
  253. ;
  254. ;    Write the record
  255. ;
  256.     GOSUB AddBRec        ; Write to Bulletins file
  257. ;
  258. ;    End of add procedure
  259. ;
  260. ADBUEnd:
  261.     WCLOSE
  262. ADBUEsc:
  263.     SET FLAG(0) ON
  264.     RETURN
  265. ; -----------------------------------------------------------------------
  266. ; ----- AddBRec:  Add a record to the Bulletin file...
  267. ;    .. S10 passes the record to be written
  268. ;
  269. AddBRec:
  270.     FOPENO S25&"\BBS-bull" TEXT APPEND
  271.     IF NOT SUCCESS        ; Open failed
  272.        S0 = "Error opening: "*S25&"\BBS-Bull"
  273.        GOSUB Error        ; Report
  274.        RETURN        ; And we're done
  275.        ENDIF
  276.     PRESERVE S10        ; Preserve ^'s and !'s
  277.     WRITE S10        ; Write the record
  278.     WRITE "!^Z"             ; And finish it
  279.     FCLOSEO
  280.     RETURN
  281. ; -----------------------------------------------------------------------
  282. ; ----- LkpFile:  Lookup a file in the BBS-Bull file
  283. ;    .. S0 passes the fname to be tested
  284. ;    .. S10 returns the record read
  285. ;
  286. LkpBull:
  287.     FOPENI S25&"\BBS-Bull" TEXT
  288.     IF NOT SUCCESS        ; Open failed
  289.        S0 = "Error opening: "*S25&"\BBS-Bull"
  290.        GOSUB Error        ; Report
  291.        SET FOUND OFF    ; Not found
  292.        RETURN        ; And we're done
  293.        ENDIF
  294. ;
  295. ;    Read loop
  296. ;
  297. LOBU100:
  298.     READ S10 80 N0        ; Read a record
  299.     IF EOF GOTO LOBU200    ; Skip on EOF
  300.     IF STRCMP S10(0:0) "*" GOTO LOBU110
  301.     IF STRCMP S10(0:4) S0(0:4) GOTO LOBU300
  302. ;
  303. ;    Record longer than 80 chars
  304. ;
  305. LOBU110:
  306.     IF N0 LT 80 GOTO LOBU100; If exactly 80 rtnd, c/r wasn't read
  307.     READ S10 80 N0        ; Read remainder of rec
  308.     GOTO LOBU110        ; Read until less than 80
  309. ;
  310. ;    We have end-of-file - not found
  311. ;
  312. LOBU200:
  313.     SET FOUND OFF        ; Indicate not found
  314.     GOTO LOBUEnd
  315. ;
  316. ;    We have a hit - return found
  317. ;
  318. LOBU300:
  319.     SET FOUND ON        ; Indicate found
  320. ;
  321. ;    And exit
  322. ;
  323. LOBUEnd:
  324.     FCLOSEI
  325.     RETURN
  326. ; -----------------------------------------------------------------------
  327. ; ----- DelBull:  Delete a file from Bulletin file
  328. ;
  329. DelBull:
  330.     SET FLAG(0) OFF     ; Flag for ESCAPE
  331.     WOPEN 10,10,15,70 (cont) DEBUEsc
  332.     ATSAY 10,12 (cont) " BBS Bulletin Delete "
  333.     ATSAY 11,12 (cont) "Enter bulletin number to del: "
  334.     ATSAY 15,26 (cont) " Press ESC to cancel "
  335.     ;
  336.     ;    Wait a keypress
  337.     ;
  338.     LOCATE 11,42
  339.     GET S0 5        ; get resp
  340.     IF FLAG(0) GOTO DEBUEnd ; Exit if ESC hit
  341.     LJ S0            ; Left justify
  342.     UPPER S0        ; Upper casefy
  343.     IF NULL S0 GOTO DEBUEnd ; get out on empty entry
  344. ;
  345. ;    Open the Bulletin file and a temp copy file
  346. ;
  347.     GOSUB DelBRec        ; Try to delete a record
  348.     IF FLAG(1) GOTO DEBUEnd ; Skip if record deleted
  349.     ATSAY 12,12 (cont) "Bulletin not in listing...     "
  350.     ATSAY 13,12 (cont) "Press any key to continue..."
  351.     KEYGET S0
  352. ;
  353. ;    End of add procedure
  354. ;
  355. DEBUEnd:
  356.     WCLOSE
  357. DEBUEsc:
  358.     SET FLAG(0) ON
  359.     RETURN
  360. ; -----------------------------------------------------------------------
  361. ; ----- DelBRec:  Delete a record from the Bulletin file...
  362. ;    .. S0 passes the bulletin number key
  363. ;    .. S1 destroyed in the process
  364. ;    .. FLAG(1) if rtn'd set, indicates record was FOUND
  365. ;
  366. DelBRec:
  367. ;
  368. ;    Open the Bulletin file and a temp copy file
  369. ;
  370.     SET FLAG(1)  OFF    ; Initialize for found flag
  371.     FOPENI S25&"\BBS-Bull" TEXT
  372.     IF NOT SUCCESS        ; Open failed
  373.        S0 = "Error opening: "*S25&"\BBS-Bull"
  374.        GOSUB Error        ; Report
  375.        GOTO DEBREnd     ; And we're done
  376.        ENDIF
  377.  
  378.     FOPENO S25&"\TempBull" TEXT
  379.     IF NOT SUCCESS        ; Open failed
  380.        S0 = "Error opening: "*S25&"\TempBull"
  381.        GOSUB Error        ; Report
  382.        GOTO DEBREnd     ; And we're done
  383.        ENDIF
  384.     N10 = 0         ; COunt recs written
  385. ;
  386. ;    Read records (40 chars at a time to allow PRESERVE)
  387. ;
  388. DEBR100:
  389.     READ S1 40 N0        ; Read 1st 40 chars
  390.     IF EOF GOTO DEBR300    ; Skip on EOF
  391.     IF STRCMP S1(0:4) S0(0:4) GOTO DEBR200
  392.     INC N10         ; COunt rec written
  393. ;
  394. ;    Copy the record read to the output file
  395. ;
  396. DEBR110:
  397.     PRESERVE S1        ; Save !'s and ^'s
  398.     WRITE S1        ; Write text
  399.  
  400.     IF N0 LT 40        ; If we wrote end of record
  401.        WRITE "!"            ; Finish w/cr/lf
  402.        GOTO DEBR100     ; And continue copying
  403.        ENDIF
  404.     READ S1 40 N0        ; Read remainder of rec
  405.     IF NOT EOF GOTO DEBR110 ; Skip if not eof
  406.     WRITE "!"               ; Finish record
  407.     GOTO DEBR300        ; End of file
  408. ;
  409. ;    We have a hit
  410. ;
  411. DEBR200:
  412.     SET FLAG(1) ON        ; Flag we deleted item
  413.     IF N0 LT 40 GOTO DEBR100
  414.     READ S1 40 N0        ; Read remainder of rec
  415.     IF NOT EOF GOTO DEBR200 ; Skip if not found
  416. ;
  417. ;    We hit EOF - may or may not have found the target rec
  418. ;
  419. DEBR300:
  420.     IF NOT FLAG(1) GOTO DEBR400 ; skip if not found
  421.     WRITE "^Z"              ; Finish ASCII file
  422.     FCLOSEO         ; Close output
  423.     FCLOSEI         ; Close input
  424.     DELETE S25&"\BBS-Bull"  ; Delete original
  425.     RENAME S25&"\TempBull" S25&"\BBS-Bull"
  426.     IF ZERO N10 DELETE S25&"\BBS-Bull" ; Delete empty file
  427.     GOTO DEBREnd
  428. ;
  429. ;    We hit EOF - we did not find the record
  430. ;
  431. DEBR400:
  432.     FCLOSEO         ; Close output
  433.     FCLOSEI         ; Close input
  434.     DELETE S25&"\TempBull"  ; Delete copy file
  435. ;
  436. ;    End of procedure...
  437. ;
  438. DEBREnd:
  439.     RETURN
  440. ; -----------------------------------------------------------------------
  441. ; ----- ModBull:  Modify a record in the bulletin file
  442. ;
  443. ModBull:
  444.     SET FLAG(0) OFF     ; Flag for ESCAPE
  445.     WOPEN 10,10,18,75 (cont) MOBUEsc
  446.     ATSAY 10,12 (cont) " BBS Bulletin Modify "
  447.     ATSAY 11,12 (cont) "Enter number to change: "
  448.     ATSAY 18,26 (cont) " Press ESC to cancel "
  449.     ;
  450.     ;    Wait a keypress
  451.     ;
  452.     LOCATE 11,42
  453.     GET S0 5        ; get resp
  454.     IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit
  455.     LJ S0            ; Left justify
  456.     UPPER S0        ; Upper case
  457.     IF NULL S0 GOTO MOBUEnd ; get out on empty entry
  458.     GOSUB LkpBull        ; Lookup in Bulletin file
  459.     IF NOT FOUND        ; If its there we can't add it
  460.        WCLOSE        ; Close open window
  461.        GOTO AddBU_Mod    ; Skip if NOT found
  462.        ENDIF
  463.     GOTO MOBU100        ; And branch around parallel code
  464. ;
  465. ;    Entry from AddBull... We have a rec in S10 - needs adding
  466. ;
  467. ModBU_Add:
  468.     WOPEN 10,10,18,75 (cont) MOBUEsc
  469.     ATSAY 10,12 (cont) " BBS Bulletin Modify "
  470.     ATSAY 11,12 (cont) "Enter number to be changed: "
  471.     ATSAY 11,42 (cont) S0
  472.     ATSAY 18,26 (cont) " Press ESC to cancel "
  473. ;
  474. ;    Display the original values (rtnd in S10 by LkpBull)
  475. ;
  476. MOBU100:
  477.     ATSAY 10,54 (cont) " Old vals "
  478.     ATSAY 11,55 (cont) S10(0:4)    ; Num
  479.     ATSAY 12,55 (cont) S10(14:25)    ; Fname
  480.     ATSAY 15,26 (cont) S10(26:65)    ; Description
  481.     IF NOT NULL S10(13:13)
  482.        ATSAY 16,55 (cont) "y"
  483.     ELSE
  484.        ATSAY 16,55 (cont) "n"
  485.        ENDIF
  486. ;
  487. ;    Ask for a file name (containing the bulletin)
  488. ;
  489. MOBU110:
  490.     DATE S1         ; Want mm/dd/yy form
  491.     S10(5:12) = S1        ; Save date mod'd
  492.     ATSAY 12,12 (cont) "Enter the file name:"
  493.     LOCATE 12,42
  494.     GET S0 12        ; get file name
  495.     IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit
  496.     LJ S0            ; Left justify
  497.     IF NULL S0 GOTO MOBU200 ; Skip if null entry
  498.     FFIRST S25&"\"*S0       ; Test for file's existence
  499.     S10(14:25) = S0     ; Save File name
  500.     IF SUCCESS GOTO MOBU200 ; Skip if exists
  501. ;
  502. ;    File does not exist...
  503. ;
  504. MOBU120:
  505.     ATSAY 13,12 (cont) "File d.n.e. Add anyway (y/n): "
  506.     LOCATE 13,42
  507.     GET S0 1        ; get resp
  508.     IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit
  509.     IF NULL S0 or NOT FIND "YN" S0(0)
  510.        SOUND 100,100    ; Indicate displeasure
  511.        GOTO MOBU120     ; Try again
  512.        ENDIF
  513.     IF FIND "N" S0(0)
  514.        WCLOSE        ; Close window
  515.        GOTO ModBull     ; And try again
  516.        ENDIF
  517. ;
  518. ;    Ask for a comment field
  519. ;
  520. MOBU200:
  521.     ATSAY 14,12 (cont) "Description: "
  522.     LOCATE 14,26
  523.     GET S0 40        ; get resp
  524.     LJ S0            ; Left justify
  525.     IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit
  526.     IF NULL S0        ; If null entry...
  527.        ATSAY 14,26 (cont) S10(26:65)
  528.        GOTO MOBU250     ; Skip store
  529.        ENDIF
  530.     S10(26:79) = S0     ; Save comment text
  531. ;
  532. ;    Ask for privileged flag
  533. ;
  534. MOBU250:
  535.     ATSAY 16,12 (cont) "Priveleged access (y/n):  "
  536.     LOCATE 16,42
  537.     GET S0 1        ; get resp
  538.     IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit
  539.     IF NULL S0 ATSCR 16,55 1 S0 ; Read back previous value
  540.     IF NOT FIND "YN" S0(0)  ; If not y/n
  541.        SOUND 100,100    ; Indicate displeasure
  542.        GOTO MOBU250     ; Try again
  543.        ENDIF
  544.     S10(13:13) = " "        ; Default no priv
  545.     IF FIND "Y" S0(0)       ; If privilege 'y'
  546.        S10(13:13) = "P"     ; Set priveleged access
  547.        ENDIF
  548. ;
  549. ;    Ask for one more look
  550. ;
  551. MOBU300:
  552.     ATSAY 17,12 (cont) "OK to add this record?:   "
  553.     LOCATE 17,42
  554.     GET S0 1        ; get resp
  555.     IF FLAG(0) GOTO MOBUEnd ; Exit if ESC hit
  556.     IF NULL S0 or NOT FIND "YN" S0(0)
  557.        SOUND 100,100    ; Indicate displeasure
  558.        GOTO MOBU300     ; Try again
  559.        ENDIF
  560.     IF FIND "N" S0(0)
  561.        WCLOSE        ; Close window
  562.        GOTO ModBull     ; And try again
  563.        ENDIF
  564. ;
  565. ;    Delete the previous value... and add the new
  566. ;    .. Could do a Delete/add but don't want file re-ordered
  567. ;
  568.     GOSUB ModBRec        ; Modify the record in S10
  569.     IF NOT FLAG(1)        ; If not deleted
  570.        S0 = "Error modifying bulletin: "*S0
  571.        GOSUB Error        ; Report
  572.        GOTO MOBUEnd     ; And we're done
  573.        ENDIF
  574. ;
  575. ;    End of add procedure
  576. ;
  577. MOBUEnd:
  578.     WCLOSE
  579. MOBUEsc:
  580.     SET FLAG(0) ON
  581.     RETURN
  582. ; -----------------------------------------------------------------------
  583. ; ----- ModBRec:  Modify a record from the Files file...
  584. ;    .. S10 passes the new record (same file name key)
  585. ;    .. S1 destroyed in the process
  586. ;
  587. ModBRec:
  588. ;
  589. ;    Open the Files file and a temp copy file
  590. ;
  591.     SET FLAG(1)  OFF    ; Initialize for found flag
  592.     FOPENI S25&"\BBS-Bull" TEXT
  593.     IF NOT SUCCESS        ; Open failed
  594.        S0 = "Error opening: "*S25&"\BBS-Bull"
  595.        GOSUB Error        ; Report
  596.        GOTO MOBREnd     ; And we're done
  597.        ENDIF
  598.  
  599.     FOPENO S25&"\TempFile" TEXT
  600.     IF NOT SUCCESS        ; Open failed
  601.        S0 = "Error opening: "*S25&"\TempFile"
  602.        GOSUB Error        ; Report
  603.        GOTO MOBREnd     ; And we're done
  604.        ENDIF
  605.     N10 = 0         ; Count recs written
  606. ;
  607. ;    Read records (40 chars at a time to allow PRESERVE)
  608. ;
  609. MOBR100:
  610.     READ S1 40 N0        ; Read 1st 40 chars
  611.     IF EOF GOTO MOBR300    ; Skip on EOF
  612.     IF STRCMP S1(0:4) S10(0:4) GOTO MOBR200
  613.     INC N10
  614. ;
  615. ;    Copy the record read to the output file
  616. ;
  617. MOBR110:
  618.     PRESERVE S1        ; Save !'s and ^'s
  619.     WRITE S1        ; Write text
  620.  
  621.     IF N0 LT 40        ; If we wrote end of record
  622.        WRITE "!"            ; Finish w/cr/lf
  623.        GOTO MOBR100     ; And continue copying
  624.        ENDIF
  625.     READ S1 40 N0        ; Read remainder of rec
  626.     IF NOT EOF GOTO MOBR110 ; Skip if not eof
  627.     WRITE "!"               ; Finish record
  628.     GOTO MOBR300        ; End of file
  629. ;
  630. ;    We have a match on the key.
  631. ;
  632. MOBR200:
  633.     SET FLAG(1) ON        ; Flag we deleted item
  634.     S1 = S10(0:39)        ; Take 1st part of rec to write
  635.     PRESERVE S1        ; Save !s and ^s
  636.     WRITE S1        ; Write text
  637.  
  638.     LENGTH S10 N1        ; Get new rec length
  639.     IF N1 LT 40 GOTO MOBR210
  640.  
  641.     S1 = S10(40:79)     ; Take 2nd part of rec to write
  642.     PRESERVE S1        ; Save !s and ^s
  643.     WRITE S1        ; Write text
  644. ;
  645. ;    Finish the new record
  646. ;
  647. MOBR210:
  648.     WRITE "!"               ; Finish record
  649. ;
  650. ;    Finish reading the original record
  651. ;
  652. MOBR220:
  653.     IF N0 LT 40 GOTO MOBR100
  654.     READ S1 40 N0        ; Read remainder of rec
  655.     IF NOT EOF GOTO MOBR220 ; Skip if not found
  656. ;
  657. ;    We hit EOF - may or may not have found the target rec
  658. ;
  659. MOBR300:
  660.     IF NOT FLAG(1) GOTO MOBR200 ; skip if not found
  661.     WRITE "^Z"              ; Finish ASCII file
  662.     FCLOSEO         ; Close output
  663.     FCLOSEI         ; Close input
  664.     DELETE S25&"\BBS-Bull"  ; Delete original
  665.     RENAME S25&"\TempFile" S25&"\BBS-Bull"
  666.     IF ZERO N10 DELETE S25&"\BBS-Bull" ; Delete empty file
  667. ;
  668. ;    End of procedure...
  669. ;
  670. MOBREnd:
  671.     RETURN
  672. ; -----------------------------------------------------------------------
  673. ; ----- PrnBull:  Print a list of bulletins
  674. ;
  675. PrnBull:
  676.     FOPENI S25&"\BBS-Bull" TEXT
  677.     IF NOT SUCCESS        ; Open failed
  678.        S0 = "Error opening: "*S25&"\BBS-Bull"
  679.        GOSUB Error        ; Report
  680.        RETURN        ; And we're done
  681.        ENDIF
  682. ;
  683. ;    Initialize a counter
  684. ;
  685.     N10 = 0         ; # Lines printed
  686.     N11 = 1         ; Page number
  687. ;
  688. ;    Read loop
  689. ;
  690. PRBU100:
  691.     READ S10 80 N0        ; Read a record
  692.     IF EOF GOTO PRBU200    ; Skip on EOF
  693.     IF STRCMP S10(0:0) "<" GOTO PRBU120 ; skip comments
  694.     IF ZERO N0 GOTO PRBU100 ; skip blank lines
  695. ;
  696. ;    Print a heading...
  697. ;
  698.     IF N10 GT 0 and N10 LE 50 GOTO PRBU110
  699.     PRINT "COM-AND Scripted BBS Bulletin list as of "*"_DATE"*", "*"_TIME"*"      Page "*N11*"^M^J"
  700.     PRINT "From: "*"_IFILE"*"^M^J"
  701.     PRINT "--------------------------------------------------------------------------^M^J"
  702.     PRINT "Numbr File         Priv Description^M^J"
  703.     PRINT "----- ------------ ---- --------------------------------------------------^M^J"
  704.     N10 = 0
  705.     INC N11
  706. ;
  707. ;    Build a record and print it
  708. ;
  709. PRBU110:
  710.     S0 = S10(0:4)        ; Number Field
  711.     S0(6:17) = S10(14:25)    ; Fname  Field
  712.     IF NOT NULL S10(13:13) S0(20:22) = "yes"
  713.     S0(24:79)  = S10(26:79) ; Description
  714.     PRESERVE S0
  715.     PRINT S0
  716.     PRINT "^M^J"            ; Finish line
  717.     INC N10         ; COunt lines printed
  718. ;
  719. ;    Handle record longer than 80 chars
  720. ;
  721. PRBU120:
  722.     IF N0 LT 80 GOTO PRBU100; If exactly 80 rtnd, c/r wasn't read
  723.     READ S10 80 N0        ; Read remainder of rec
  724.     GOTO PRBU120        ; Read until less than 80
  725. ;
  726. ;    We have end-of-file
  727. ;
  728. PRBU200:
  729.     PRINT "^L"              ; Do a final top-of-form
  730. ;
  731. ;    And exit
  732. ;
  733. PRBUEnd:
  734.     FCLOSEI
  735.     RETURN
  736. ; -----------------------------------------------------------------------
  737. ; ----- ViewBull: View a list of bulletins
  738. ;
  739. ViewBull:
  740.     FOPENI S25&"\BBS-Bull" TEXT
  741.     IF NOT SUCCESS        ; Open failed
  742.        S0 = "Error opening: "*S25&"\BBS-Bull"
  743.        GOSUB Error        ; Report
  744.        RETURN        ; And we're done
  745.        ENDIF
  746. ;
  747. ;    Initialize a counter
  748. ;
  749.     N10 = 0         ; # Lines printed
  750.     N11 = 0         ; Page number
  751.     SET FLAG(0) OFF     ; Initialize esc flag
  752.     S11 = "_ONESC"
  753.     ON ESCAPE GOSUB VIBUESC
  754. ;
  755. ;    Print a heading...
  756. ;
  757. VIBU100:
  758.     IF N10 GT 0 GOTO VIBU110
  759.     CLEAR            ; Clear the window
  760.     ATSAY 1,2 (defa) "Numbr File         Priv Description"
  761.     ATSAY 2,2 (defa) "----- ------------ ---- --------------------------------------------------"
  762.     N10 = 3         ; Set starting line no
  763.     INC N11         ; Set next page
  764. ;
  765. ;    Save the file position for the start of this page
  766. ;
  767.     FSAVEI
  768.     IF NOT SUCCESS
  769.        FSAVEI SHIFT     ; Save last 20 pos'ns
  770.        FSAVEI
  771.        ENDIF
  772. ;
  773. ;    Read loop
  774. ;
  775. VIBU110:
  776.     READ S10 80 N0        ; Read a record
  777.     IF EOF GOTO VIBU200    ; Skip on EOF
  778.     IF STRCMP S10(0:0) "<" GOTO VIBU120 ; skip comments
  779.     IF ZERO N0 GOTO VIBU110 ; skip blank lines
  780. ;
  781. ;    Build a record and print it
  782. ;
  783.     S0 = S10(0:4)        ; Number Field
  784.     S0(6:17) = S10(14:25)    ; Fname  Field
  785.     IF NOT NULL S10(13:13) S0(20:22) = "yes"
  786.     S0(24:74)  = S10(26:79) ; Description
  787.     PRESERVE S0
  788.     ATSAY N10,2 (defa) S0
  789.     INC N10         ; COunt lines printed
  790. ;
  791. ;    Handle record longer than 80 chars
  792. ;
  793. VIBU120:
  794.     IF N0 LT 80 GOTO VIBU200; If exactly 80 rtnd, c/r wasn't read
  795.     READ S10 80 N0        ; Read remainder of rec
  796.     GOTO VIBU120        ; Read until less than 80
  797. ;
  798. ;    Look for end of screen/end of file
  799. ;
  800. VIBU200:
  801.     IF (NOT EOF) and N10 LT 21 GOTO VIBU100
  802.     IF EOF
  803.        ATSAY 22,2 (defa) "End of file; Home (top), PgDn (forward), PgUp (back)"
  804.     ELSE
  805.        ATSAY 22,2 (defa) "Page "*N11*"; Home (top), PgDn (forward), PgUp (back)"
  806.        ENDIF
  807. ;
  808. ;    Read a key and interpret
  809. ;
  810. VIBU210:
  811.     IF FLAG(0) RETURN    ; End of routine when flag set
  812.     KEYGET S1
  813.     IF FLAG(0) RETURN    ; End of routine when flag set
  814.     SWITCH S1
  815.       CASE "4900"           ; Pgup
  816.         GOTO PgUp
  817.         ENDCASE
  818.       CASE "5100"           ; PgDn
  819.         GOTO PgDn
  820.         ENDCASE
  821.       CASE "4700"           ; Home
  822.         GOTO Home
  823.         ENDCASE
  824.       CASE "0D"             ; C/r
  825.         IF EOF GOTO VIBUEnd
  826.         GOTO PgDn
  827.         ENDCASE
  828.       CASE "2100"           ; Alt-F
  829.         MANUAL "0x2100"     ; Perform Dir cmd
  830.         ENDCASE
  831.       CASE "1000"           ; Alt-Q
  832.         MANUAL "0x1000"     ; Edit a file
  833.         ENDCASE
  834.       CASE "7100"           ; Alt-F10
  835.         SHELL
  836.         DWINDOW 1,2,22,78    ; Reset dwindow after shell
  837.         LEGEND "_LEGEND"    ; Redo the legend
  838.         ENDCASE
  839.       DEFAULT
  840.         MESS S1
  841.         SOUND 100,100
  842.         ENDCASE
  843.       ENDSWITCH
  844.     GOTO VIBU210
  845. ;
  846. ;    Page up (go backwards)
  847. ;
  848. PgUp:
  849.     N10 = 0         ; Clear line ctr
  850.     FRESTOREI        ; Backup current pg
  851.     N11 = N11-1        ; Reset Page # for redisplay
  852.     FRESTOREI        ; Backup one more
  853.     IF NOT SUCCESS
  854.        SOUND 200,100    ; Indicate problem
  855.        GOTO Home
  856.        ENDIF
  857.     N11 = N11-1        ; Reset Page # for redisplay
  858.     GOTO VIBU100
  859. ;
  860. ;    Home (go to top)
  861. ;
  862. Home:
  863.     N10 = 0         ; Clear line ctr
  864.     N11 = 0         ; Set new pg number
  865.     FSAVEI CLEAR        ; Clear saved pages
  866.     REWIND            ; Rewind input
  867.     GOTO VIBU100
  868. ;
  869. ;    Page down (go forwards)
  870. ;
  871. PgDn:
  872.     IF EOF GOTO Home    ; Wrap to home at EOF
  873.     N10 = 0         ; Clear line ctr
  874.     GOTO VIBU100
  875. ;
  876. ;    And exit
  877. ;
  878. VIBUEnd:
  879.     FCLOSEI
  880.     RETURN
  881. ;
  882. ;    Escape entered
  883. ;
  884. VIBUESC:
  885.     SET FLAG(0) ON
  886.     ON ESCAPE GOSUB S11    ; Restore previous ON ESC
  887.     RETURN
  888. ; -----------------------------------------------------------------------
  889. ; ----- Subroutine: NewBull -> Create a new BBS-Bull file
  890. ;
  891. NewBull:
  892.     IF ISFILE S25&"\BBS-Bull" RETURN
  893.     FOPENO S25&"\BBS-Bull" TEXT
  894.     IF NOT SUCCESS RETURN    ; Open failed
  895.     WRITE "!^Z"             ; Make it empty
  896.     FCLOSEO         ; Done with it
  897.     RETURN
  898. ; -----------------------------------------------------------------------
  899. ; ----- Error:    Open a window, display a message, and wait for keypress
  900. ;    S0 passes the error message
  901. ;
  902. Error:
  903.     WOPEN 10,10,12,70 (cont) Err_Esc
  904.     ATSAY 10,12 (cont) " Error "
  905.     ATSAY 11,12 (cont) S0(0:55); Max msg width 55 chars
  906.     ATSAY 12,26 (cont) " Press any key to continue "
  907.     ;
  908.     ;    Wait a keypress
  909.     ;
  910.     KEYGET S0        ; Wait for any key
  911.     WCLOSE
  912. Err_Esc:
  913.     RETURN
  914.